COMMENT ⊗   VALID 00030 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   -*-MIDAS-*-
C00005 00003
C00009 00004
C00012 00005
C00015 00006
C00024 00007
C00026 00008
C00030 00009
C00032 00010
C00035 00011
C00037 00012
C00039 00013
C00041 00014
C00044 00015
C00046 00016
C00050 00017
C00052 00018
C00054 00019
C00056 00020
C00058 00021
C00060 00022
C00063 00023
C00065 00024
C00070 00025
C00072 00026
C00075 00027
C00078 00028
C00080 00029
C00083 00030
C00085 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** MACLISP ERROR HANDLERS, AND MSGS ********
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************

SUBTTL	ERROR UUO HANDLERS

.SEE EPRINT
EPRNT1:
IFE QIO,[
	PUSHJ P,SAVX3		;ERROR PRINT
	PUSHJ P,TLPRINT
	JRST RSTX3
]		;END OF IFE QIO
IFN QIO,[
	PUSHJ P,SAVX5		;ERROR PRIN1
	PUSH P,AR1	.SEE ERROR3
	PUSHJ P,MSGFCK
	SKIPN V%PR1
	 JRST EPRNT2
	MOVEI B,(AR1)
	CALLF 2,@V%PR1
	JRST EPRNT3

EPRNT2:	TLO AR1,200000
	PUSHJ P,$PRIN1
EPRNT3:	STRT 17,[SIXBIT \ !\]
	POP P,AR1
	JRST RSTX5
]		;END OF IFN QIO


ERROR1:	MOVEM TT,UUTTSV
	MOVEM R,UURSV
EROR1Z:	JSP TT,ERROR9		;PROCESS A LISP ERROR
	 JRST EROR1A		; (LERR AND LER3)
Q%	SKIPE VJPG	;***** CROCK!!!!! FOR JPG *****
Q%	 JRST EROR1Q
Q%	SKIPE VERRSET
Q%	 SKIPN ERRTN
Q% EROR1Q:	SETZM TTYOFF
Q%	JSR ERROR3
Q$	PUSHJ P,MSGFCK
Q$	MOVEI D,-2(P)		;D POINTS TO ERRFRAME
Q$	PUSHJ P,ERROR3
EROR1A:	MOVEI A,NIL
	JRST 2,@[ERRRTN]

IFN QIO,[
;;; MSGFILES CHECK.  GET VALUE OF MSGFILES IN AR1 AFTER CHECKING FOR
;;; VALIDITY.  IF A LOSER, SIGNAL AN ERROR AFTER RESTORING IT TO (T).
;;; SAVES A.

MSGFCK:	HRRZ AR1,VMSGFILES
SFA$	JSP F,MSGFC1		;MAKE SURE AN SFA NEVER GETS INVOKED FROM
SFA$	0			; MPFLOK, BUT STILL DO VALIDITY CHECK
SFA$ MSGFC1:
	PUSHJ P,MPFLOK		;SKIPS IF LIST OF FILES *NOT* VALID
CMSGFCK: POPJ P,MSGFCK
	PUSH P,A
	MOVEI A,(AR1)
	PUSHJ P,NCONS
	MOVEI B,QMSGFILES
	PUSHJ P,XCONS
	MOVEI AR1,QTLIST
	MOVEM AR1,VMSGFILES
	PUSHJ P,[IOL [BAD VALUE FOR MSGFILES!]]
	POP P,A
	JRST MSGFCK
]		;END OF IFN QIO

SUBTTL	ERRFRAME FORMATS

;;; FORMAT OF ERRFRAME:
;;;
;;; [1] NORMAL TYPE ERROR (ERINT, LERR, ETC.)
;;;		<SP>,,<RETURN FROM ERROR IF ERINT>
;;;		$ERRFRAME
;;;		<UUO>		;ADDRESS OF MSG IN RIGHT HALF
;;;		<S-EXP>		;FOR ERINT, LER3
;;;
;;; [2] ERRBAD TYPE ERROR (ILL MEM REF, ETC.)
;;;		<SP>,,<ADDRESS WHERE ERROR OCCURRED>
;;;		$ERRFRAME
;;;		0,,<ADDRESS OF MSG>
.SEE ERRBAD

ERROR9:	PUSH P,UUOH
	HRLM SP,(P)
	PUSH P,[$ERRFRAME]	;RANDOMNUMBER,,EPOPJ
	PUSH P,40		;CANNOT HAVE LH = 0; SEE ERRPRINT
	PUSH P,A
LERFRAME==:4			;LENGTH OF ERRFRAME - WATCH THIS IN CASE OF CHANGE
Q%	PION			; - SHOULD BE LESS THAN 20 (FOR R70 REFS - SEE ERRV)
IFN QIO,[
IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
]		;END OF IFN QIO
EROR9A:	SKIPN PSYMF
	 SKIPE ERRSW
	  JRST 1(TT)
	JRST (TT)

;;; ERROR RETURN.  COME HERE TO PERFORM AN ERROR BREAKOUT (RETURN
;;; TO ERRSET OR TOP LEVEL).  VALUE TO RETURN FROM ERRSET IN A.

ERRRTN:	SETZM NOQUIT
Q%	PION			;ERROR PROCESSING RETURNS HERE TO RECOUP BACK
IFN QIO,[
IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
]		;END OF IFN QIO
	PUSH P,A
Q$	SKIPL A,UNREAL
	PUSHJ P,CHECKU		;CHECK FOR ANY DELAYED "REAL TIME" INTS
	POP P,A
ERR2:	SKIPE ERRTN		;TO TOPLEVEL, OR BREAK OUT OF AN ERRSET
	JRST ERR0		;GO BREAK UP AN ERRSET
LSPRT0:	PUSH FXP,CATRTN		;RETURN TO TOP LEVEL FROM LISP ERROR
	JSP A,ERINI0
	POP FXP,CATRTN		;GJS NEEDS TO THROW FROM A *RSET-TRAP
CLSPRET:
	SETZ A,LSPRET
	SKIPE B,V.TRAP		;INVOKE *RSET-TRAP
	 CALLF 1,(B)
	MOVE A,VERRLIST
	MOVEM A,VIQUOTIENT
	JUMPE A,LSPRET
	HRRZ T,C2
	HRRZ T,1(T)
	CAIE T,HACENT		;MEANS BUG ON ERRLIST
	 JRST LSPRET
	MOVE A,VERRLIST
	PUSHJ P,NCONS
	MOVEI B,QERRLIST
	PUSHJ P,XCONS
	PUSH P,CLSPRET
	FAC [POSSIBLY FELONIOUS ERRLIST - PLEASE INSPECT BEFORE PROCEEDING!]


SUBTTL	ERINT, SERING, LERR, LER3

;ERROR3:	0	;PRINT OUT ERROR MESSAGE FOR ORDINARY
			; LISP ERRORS (LERR, LER3, ERINT, SERINT)
Q% EROR3A:
Q$ ERROR3:		;FOR QIO, CALLED VIA  PUSHJ P,ERROR3
			;POINTER TO $ERRFRAME IN D
Q$	MOVEI A,TRUTH		;PREVENT AUTO-TERPRI IN THE
Q$	JSP T,SPECBIND		; MIDDLE OF AN ERROR MESSAGE
Q$	   0 A,V%TERPRI		;SPECBIND SAVES D
Q$	HRLI AR1,200000	;OUTPUT FILES LIST FOR MSG IN AR1
Q%	LDB TT,[331100,,-1(P)]	;P HAS BEEN STACKED UP BY ERROR9
Q$	LDB TT,[331100,,1(D)]	;P HAS BEEN STACKED UP BY ERROR9
	JUMPE TT,EROR3C		;ERRBD2 PUSHS MSG WITH NO LERR OPERATION
Q$	HRRZ A,2(D)		;MUST FETCH THE S-EXPRESSION TO PRINT
Q$	STRT AR1,[SIXBIT \↑M;!\]	;PRECEDE MSG WITH A ";"
	CAIE TT,LERR←-33	;LERR DOESN'T PRINT AN S-EXP
	 PUSHJ P,EPRINT
	CAIN TT,SERINT←-33	;SERINT HAS AN S-EXP MSG
	 JRST EROR3F
Q%	LDB A,[270400,,-1(P)]	;IF IT IS LERR OR LER3, THEN
Q$	LDB A,[270400,,1(D)]	;IF IT IS LERR OR LER3, THEN
	CAIE TT,ERINT←-33	; A NON-ZERO AC FIELD MEANS
	 JUMPN A,EROR3F		; THE MSG IS AN S-EXP
EROR3C:
Q%	STRT @-1(P)		;NOTE THAT THIS CLOBBERS ALL UUOH LEVEL VARS
Q$	STRT AR1,@1(D)		;NOTE: THIS CLOBBERS UUOH LEVEL VARS
EROR3E:	STRT AR1,STRTCR
Q%	JRST 2,@ERROR3
Q$	JRST UNBIND

EROR3F:
Q%	HRRZ A,-1(P)		;SERINT IS ERINT WITH S-EXPRESSION MSG
Q%	PUSHJ P,PRINC
Q$	HRRZ A,1(D)
Q$	PUSHJ P,$PRINC
	JRST EROR3E

IFE QIO,[
;ERROR4:	0		;PRINT ERROR MESAGE FOR ERRBAD TYPE ERRORS
EROR4A:	STRT [SIXBIT \↑M;!\]	;SAVES T, FORTUNATELY
	HRRZ TT,-1(T)
	STRT @1(T)		;MAIN PART OF ERR MSG PRINTED HERE
	STRT [SIXBIT \ FROM LOCATION !\]
	PUSH FXP,TT
	MOVEI R,TYO
	PUSHJ P,PRINL4		;LOSING PC PRINTED HERE
	POP FXP,B
	STRT [SIXBIT \↑M;PROGRAM TRAPPED WHILE IN !\]
	PUSHJ P,ERRADR		;PRINT NAME OF LOSING FUNCTION HERE
	PUSHJ P,ITERPRI
	JRST 2,@ERROR4
]		;END OF IFE QIO

;;; PROCESS ERINT/SERINT CORRECTABLE INTERRUPTS

ERROR5:	MOVEM TT,UUTTSV
	MOVEM R,UURSV
	SKIPN ERRTN		;ALLOW USER INTERRUPT TO RUN,
	 JRST EROR5F		; EVEN IF INSIDE AN ERRSET,
	SKIPN VERRSET		; IF THE ERRSET BREAK IS SET
	 JRST ERROR1		;OTHERWISE, JUST DO NORMAL ERROR
EROR5F:	LDB TT,[270400,,40]
	CAIGE TT,NERINT		;TT HAS AC FIELD FROM UUO
	 SKIPN VUDF(TT)
	  JRST ERROR1		;CONVERT TO LER3 IF NOT ENABLED
	MOVEI T,ERRV		;NORMAL XIT FROM CODE BELOW IS POP2J,
Q$	CAIE TT,<%IOL←-27>&17	;IO-LOSSAGE
	 CAIN TT,<%FAC←-27>&17	;FAIL-ACT
	  MOVEI T,EVAL.A
EROR5A:	PUSH FXP,T
	MOVEI T,(TT)	;SAVE AC NUMBER FOR BELOW
	JSP TT,ERROR9	;PUSH AN ERROR FRAME
	 JFCL
	MOVEI A,(A)
	PUSH FXP,T
	JSP T,PDLNMK
Q%	POP FXP,T
Q%	CAIG T,<%UGT←-27>&17	;LISTIFY ONLY FOR UDF, UBV, WTA, AND UGT
Q$	EXCH D,(FXP)
Q$	CAIG D,<%UGT←-27>&17
	 PUSHJ P,ACONS
	PUSH P,A		;FOR GC PROTECTION ONLY
Q%	MOVSI A,(A)
Q%	HRRI A,ERSTBK+1(T)
Q$	TRO D,2000		;ERINT SERIES USER INTERRUPT
Q$	HRLI D,(A)
	MOVE TT,UUTTSV
	MOVE T,UUTSV
	SKIPN INHIBIT
	 SKIPE NOQUIT
	  .VALUE		;STUPID TO SIGNAL ERROR WHEN INTERRUPTS LOCKED
	PUSHJ P,UINT
Q$	POP FXP,D
	SUB P,R70+1		;GC PROTECTION NO LONGER NEEDED
	JUMPE A,EROR6A
	PUSH FXP,TT
	SKOTT A,LS
	 JRST EROR6A
	POP FXP,TT
	HLRZ A,(A)		;IF ATOM RETURNED, THEN CRAP OUT
				;OTHERWISE, RETURNED VALUE IS LIST OF
	 POPJ FXP,		;CORRECT QUANTITY MUST GO TO EVAL.A OR ERRV
EROR6A:	MOVE A,(P)		;RESTORE A
	MOVEI TT,EROR1Z		;USER DIDN'T SUPPLY SUITABLE VALUE
	JRST EROR9A		;SO ERROR OUT

ERRV:	SUB P,R70+LERFRAME-1	;CLEAR OUT ALL BUT RETURN ADDRESS
	POPJ P,

IFN QIO,[

;;; IOJRST UUO DECODER. USAGE:
;;;		.CALL FOO	;OR .OPEN, OR WHATEVER
;;;		 IOJRST N,FOO
;;; IOJRST CAUSES A TRANSFER TO FOO AFTER PUTTING IN C THE
;;; ADDRESS OF A SIXBIT (STRT FORMAT) STRING INDICATING THE
;;; ERROR MESSAGE.  THIS MESSAGE MAY BE GIVEN TO AN ERINT
;;; UUO (TYPICALLY %IOL).  N IS THE NUMBER OF THINGS ON THE
;;; REGPDL ABOVE THE RETURN ADDRESS - THIS IS A CROCK SO THAT
;;; IOJRST CAN STICK THE ADDRESS OF A RESTORATION ROUTINE
;;; ON THE PDL.  (THIS ISN'T DONE IN THE D10 VERSION, HOWEVER.)
;;; FOR ITS, THE MOST RECENT ERROR AS DETERMINED BY .BCHN IS
;;; OBTAINED VIA THE ERR DEVICE AND STACKED UP ON FLP.
;;; FOR D10, TT IS ASSUMED TO CONTAIN THE LOOKUP/ENTER/RENAME
;;; ERROR CODE OF INTEREST, AND IS USED TO INDEX A TABLE.
;;; FOR D20, THE MOST RECENT ERROR IS OBTAINED FROM THE ERSTR
;;; JSYS AND STACKED UP ON FLP.
;;; CLOBBERS THE JCL BUFFER!
;;; USER INTERRUPTS SHOULD BE INHIBITED.

ERRIOJ:
10%	PUSH P,A		;SAVE ACS
10%	PUSH P,B
IFN D10,[
	HRRE C,TT		;ISOLATE ERROR CODE
	SKIPL C			;IF TT CONTAINS SOME WEIRD
	 CAILE TT,LERTBL	; VALUE, JUST CALL IT THE
	  SKIPA C,ERTBL-1	; "UNKNOWN ERROR"
	   MOVE C,ERTBL(C)	;OTHERWISE USE A STANDARD MESSAGE FROM THE TABLE
]		;END OF IFN D10
IFN ITS+D20,[
	PUSHN P,2		;PUSH 2 SPARE PDL SLOTS
	LDB A,[270400,,40]	;GET N
	ADDI A,2		;ADD 2 FOR PUSHED ACS
	MOVEI C,(P)
ERIOJ1:	MOVE B,-2(C)		;SHUFFLE PDL UP TWO SLOTS
	MOVEM B,(C)
	SUBI C,1
	SOJG A,ERIOJ1
	MOVEM FLP,-1(C)		;SAVE CURRENT FLP POINTER
	MOVEI A,ERIOJ9		;PLOP IN ADDRESS OF RESTORATION ROUTINE
	MOVEM A,(C)
	MOVEI C,1(FLP)
	PUSH FXP,C
IFN ITS,[
	.SUSET [.RBCHN,,A]
	.CALL ERIO6B
	 .LOSE 1400
	.CALL ERIOJ6		;GET MOST RECENT ERROR FOR THIS JOB
	 .LOSE 1400
	MOVE A,[440700,,JCLBF]
	MOVEI B,LJCLBF*BYTSWD-1
	.CALL ERIO6A		;READ IT IN USING A SIOT
	 .LOSE 1400
	.CLOSE TMPC,
]		;END OF IFN ITS
IFN D20,[
	HRROI 1,JCLBF
	HRLOI 2,.FHSLF		;GET MOST RECENT ERROR FOR THIS FORK
	HRLZI 3,-<LJCLBF*BYTSWD-1>
	ERSTR
	 HALT			;GROSS ERROR
	 JFCL			;BUFFER NOT BIG ENOUGH
]		;END OF IFN D20
	IDPB NIL,A
	MOVEI A,'#		;# IS THE STRT QUOTE CHARACTER
	PUSH FXP,[440700,,JCLBF]
ERIOJ2:	MOVSI B,(440600,,(FLP))
	PUSH FLP,R70
ERIOJ3:	ILDB C,(FXP)		;GET A CHARACTER OF THE ERROR MESSAGE
	CAIGE C,40
	 JRST ERIOJ8		;ANY CONTROL CHARACTER TERMINATES IT
	CAIGE C,140		;CONVERT CHARACTER TO SIXBIT,
	 SUBI C,40		; ALLOWING LOWER CASE TO WORK
	ANDI C,77
	CAIE C,'#		;SOME CHARACTERS REQUIRE QUOTING
	 CAIN C,'↑
	  JRST ERIOJ5
	CAIN C,'!
	 JRST ERIOJ5
ERIOJ4:	IDPB C,B		;DEPOSIT SIXBIT ON FLP
	TLNE B,770000
	 JRST ERIOJ3
	JRST ERIOJ2		;NO MORE ROOM - MUST PUSH ANOTHER WORD

ERIOJ5:	IDPB A,B		;DEPOSIT QUOTING CHARACTER
	TLNE B,770000
	 JRST ERIOJ4		;GO DEPOSIT REAL CHARACTER
	MOVSI B,(440600,,(FLP))
	PUSH FLP,R70		;NEED ANOTHER WORD FIRST
	JRST ERIOJ4

ERIOJ8:	POPI FXP,1		;FLUSH THE BYTE POINTER ON FXP
	POP FXP,C
ERIOJ7:	MOVEI A,'!		;MUST WRITE TERMINANTION INTO STRING
	IDPB A,B
	POP P,B			;RESTORE A AND B
	POP P,A
]		;END OF IFN ITS+D20
	MOVE T,UUTSV
	JRST @40		;THAT'S 40, NOT UUOH!  MUST EFFECT A TRANSFER

IFN ITS,[
ERIO6B:	SETZ
	SIXBIT/STATUS/
	A			;BAD CHANNEL
	402000,,A		;STATUS RETURNED

ERIOJ6:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	   1000,,TMPC		;CHANNEL NUMBER
	      ,,[SIXBIT \ERR\]	;DEVICE NAME
	1000,,3			;3 MEANS ERROR STATUS IN FN2
	400000,,A

ERIO6A:	SETZ
	SIXBIT \SIOT\		;STRING I/O TRANSFER
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,A		;BYTE POINTER
	400000,,B		;BYTE COUNT
]		;END OF IFN ITS

IFN ITS+D20,[
;;; RESTORATION ROUTINE

ERIOJ9:	POP P,FLP		;RESTORE FLP
	POPJ P,			;NOW REALLY RETRN FROM ORIGINAL FUNCTION
]		;END OF IFN ITS+D20

IFN D10,[
;;; TABLE OF STANDARD LOOKUP/ENTER/RENAME ERRORS

	[SIXBIT \UNKNOWN ERROR!\]
ERTBL:
OFFSET -.
ERFNF%::	[SIXBIT \FILE NOT FOUND!\]
ERIPP%::	[SIXBIT \NON-EXISTENT PPN!\]
ERPRT%::	[SIXBIT \PROTECTION VIOLATION!\]
ERFBM%::	[SIXBIT \FILE BUSY BEING MODIFIED!\]
ERAEF%::	[SIXBIT \FILE ALREADY EXISTS!\]
ERISU%::	[SIXBIT \ILLEGAL SEQUENCE OF UUOS!\]
ERTRN%::
	SA%	[SIXBIT \TRANSMISSION ERROR!\]
	SA$	[SIXBIT \DIFFERENT FILENAME SPECIFIED!\]
ERNSF%::
	SA%	[SIXBIT \NOT A SAVE FILE!\]
	SA$	[SIXBIT \THIS ERROR CAN'T HAPPEN!\]
ERNEC%::
	SA%	[SIXBIT \NOT ENOUGH CORE!\]
	SA$	[SIXBIT \BAD RETRIEVAL ##10!\]
ERDNA%::
	SA%	[SIXBIT \DEVICE NOT AVAILABLE!\]
	SA$	[SIXBIT \BAD RETRIEVAL ##11!\]
ERNSD%::
	SA%	[SIXBIT \NO SUCH DEVICE!\]
	SA$	[SIXBIT \DISK IS FULL!\]
IFE SAIL,[
ERILU%::	[SIXBIT \ILLEGAL UUO!\]
ERNRM%::	[SIXBIT \NO ROOM ON FILE STRUCTURE!\]
ERWLK%::	[SIXBIT \DEVICE WRITE-LOCKED!\]
ERNET%::	[SIXBIT \NOT ENOUGH MONITOR TABLE SPACE!\]
ERPOA%::	[SIXBIT \PARTIAL ALLOCATION ONLY!\]
ERBNF%::	[SIXBIT \BLOCK NOT FREE!\]
ERCSD%::	[SIXBIT \CAN'T SUPERSEDE DIRECTORY!\]
ERDNE%::	[SIXBIT \CAN'T DELETE NON-EMPTY DIRECTORY!\]
ERSNF%::	[SIXBIT \SFD NOT FOUND!\]
ERSLE%::	[SIXBIT \SEARCH LIST EMPTY!\]
ERLVL%::	[SIXBIT \SFD NESTED TOO DEEP!\]
ERNCE%::	[SIXBIT \NO-CREATE FOR ALL SEARCH LISTS!\]
ERSNS%::	[SIXBIT \NON-SWAPPED SEGMENT!\]
ERFCU%::	[SIXBIT \CAN'T UPDATE FILE!\]
ERLOH%::	[SIXBIT \SEGMENTS OVERLAP!\]
ERNLI%::	[SIXBIT \NOT LOGGED IN!\]
]		;END OF IFE SAIL
LERTBL==:.
OFFSET 0
]		;END OF IFN D10

]		;END OF IFN QIO

SUBTTL	HAIRY PDL OVERFLOW HANDLER FOR DEC-10 (OLDIO)

IFN D10&<QIO-1>,[

PDLOV:	HLRZ A,NOQUIT
	JUMPN A,GCPDLOV		;PDL OV IN GC - LOSE, LOSE, LOSE!!!
	MOVE A,.JBTPC"
	MOVEM A,IPCLOK
PDLOV1:	JUMPGE P,RPOV
	JUMPGE SP,SPOV
	JSR INTWAIT
	 JFCL
	JUMPGE FLP,[LERR POVFLP]
	JUMPL FXP,[LERR [SIXBIT \USER PDL OVERFLOW!\]]
XPOV:	HRRZ A,OFXC2		;CHECK TO SEE IF ALREADY OPERATION IN OVERFLO AREA
	CAIGE A,(FXP)
	 JRST XPOV1
	ADD FXP,[-LOFXPDL,,0]	;SO INCREASE PDL LENGTH BY OVERFLO ALLOTMENT
	LERR POVFXP		;ORDINARY ERROR - TRAPPABLE

XPOV1:	MOVEI B,POVFXP
	JRST PDLOV5		;MUST TAKE A LITTLE DRASTIC ACTION

SPOV:	SUB SP,R70+1
	HRRZ A,OSC2		;UNDO THE CURRENT BATCH OF BINDINGS
	SUBI A,(SP)
	HRRZ TT,SPSV		;THAT CAUSED THE OVERFLO
	PUSHJ P,UBD
	JUMPL A,SPOV1
	ADD SP,[-LOSPDL,,0]
	LERR POVSPDL

SPOV1:	SKIPN ERRTN		;IF NOT ERRSET, THE UNDO BACK TO TOP LEVEL
	 PUSHJ FXP,ERRPOP	;SO THAT *RSET-TRAP CAUSES NO OVERFLO
	MOVEI B,POVSPDL
	JRST PDLOV5

RPOV:	HRRZ A,OC2
	CAIGE A,(P)
	 JRST RPOV7
	ADD P,[-LOPDL+2,,0]	;2 EXTRA, FOR CASES WHERE WE NEED P
	LERR POVPDL		; UNDER PIOF, E.G. SPOV

RPOV7:	MOVE P,OC2
	MOVEI B,POVPDL		;FALL THROUGH TO PDLOV5!!!
]		;END OF IFN D10&<QIO-1>

	SUBTTL DEC-10 HAIRY PDL OVERFLOW HANDLER (NEWIO)

IFN D10&QIO,[
PDLOV:	MOVE F,INTPDL		;INTERRUPT ROUTINES MUST LOAD INTPDL INTO F
	MOVE R,IPSWD1(F)	;GET OLD INTERRUPT MASK
IFE SAIL,[
	TRZ R,AP.CLK		;LEAVE ON ALL EXCEPT CLOCK INTS
	MOVEM R,IMASK		;REMEMBER, ALLOW PDL OV IN PDL OV HANDLER
	APRENB R,
]	;END IFE SAIL
IFN SAIL,[
	TLZ R,4			;TURN OFF <ESC>I INTERRUPTS
	MOVEM R,IMASK
	INTMSK R		;LEAVE ON ALL BUT ESC<I> AND CLOCK INTS
]	;END IFN SAIL
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;PDL OV IN GC - LOSE, LOSE, LOSE!!!
	MOVEI R,P		;NOW, AS GLS SAYS, "20 QUESTIONS"
	JUMPGE P,PDLH0
	MOVEI R,SP
	JUMPGE SP,PDLH0
	MOVEI R,FLP
	JUMPGE FLP,PDLH0
	MOVEI R,FXP
	JUMPGE FXP,PDLH0
	HLRZ R,NOQUIT
	SKIPN R
	 LERR [SIXBIT \RANDOM PDL OVERFLOW!\]
	JRST INTXT2

PDLH0:	HRRZ D,OC2-P(R)		;GET ORIGION OF OVERFLOW AREA
	CAIGE D,@(R)		;IF OVER THEN LOSE
	 JRST PDLLOS
	CAIG D,@(R)		;IF EQUAL THEN WE HAVE REALLY OVERFLOWED
	 JRST PDLOV1
;IF WE ARRIVE HERE THEN WHAT HAS HAPPENED IS THAT A ROUTINE IS FORCING A
;RECALCULATION OF THE LENGTH OF THE PDL AND THERE DOES NOT ACTUALLY
;EXIST A PDL OV.  THEREFORE, ALL WE HAVE TO DO IS TO CALCULATE THE
;NUMBER OF WORDS REMAINING IN THE PDL AND RETURN TO MAINLINE.
	HRRZ D,(R)		;GET PDL POINTER
	HRRZ F,C2-P(R)		;GET PDL ORIGION
	SUBI D,(F)		;COMPUTE NUMBER OF WORDS USED
	HLRZ F,C2-P(R)		;GET FULL SIZE OF PDL
	ADDI F,(D)		;COMPUTER CURRENT SIZE
	HRLM F,(R)		;STORE LENGTH IN PDL POINTER
	HRRZ F,INTPDL		;THEN JUST RETURN NORMALLY
	JRST INTXT2

;HERE IF WE HAVE A REAL PDL OV BUT STILL HAVE SOME EMERGENCY SPACE TO USE
PDLOV1:	MOVE F,OC2-P(R)		;GET OVERFLOW POINTER
	MOVEM F,(R)		;STORE IN APPROPRIATE PDL
	MOVSI D,QREGPDL-P(R)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLRET:	HRRZ F,INTPDL
	JRST INTXT2

PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,$IWAIT	; OVERFLOW HANDLER!!!
	 JRST XUINT
	JRST INTXIT

PDLLOS:	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
Q$	STRT @PDLMSG-P(R)
	JRST DIE

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC
]		;END OF IFN D10&QIO

SUBTTL	UNRECOVERABLE PDL OVERFLOW ACTION

PDLOV5:
Q%	PION
IFN QIO,[
IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
]		;END OF IFN QIO
	STRT UNRECOV
	STRT (B)
	SKIPN ERRTN	;BACK TO TOPLEVEL IF NOT ERRSET
	 JRST LSPRET
	JSP T,GOBRK	;BREAK UP THE ERRSET, AND SEE IF
	MOVEI A,NIL
	HRRZ TT,OFXC2	;ENOUGH PDL SPACE WAS RELEASED
	HRRZ D,OSC2	;THEREBY.  IF NOT, THEN DO MAJOR
	CAILE D,(SP)	;RESTART
	 CAIG TT,(FXP)
	  JRST PDLOV6
	HRRZ D,OC2
	HRRZ TT,OFLC2
	CAILE D,(P)
	 CAIG TT,(FLP)
	  JRST PDLOV6
	JRST (T)	;HERE IS ERRSET'S ERROR EXIT

PDLOV6:	SETZM TTYOFF
	MOVE P,C2
	PUSHJ P,ERRPNU		;UNDO SPECIAL BINDINGS, NO UNWIND-PROTECTS RUN
	STRT MESMAJ
	JRST LISPGO		;BIG RESTART

SUBTTL	ILLEGAL OPERATION AND MEMORY VIOLATION HANDLER

IFE QIO,[

;;; "UNRECOVERABLE" AND MACHINE TRAP ERRORS ARE PROCESSED HERE

ERRBAD:	MOVEI A,0	;"BAD" ERROR
	MOVE TT,UUOH
ERRBD1:	AOJA TT,ERRBD2

PARERR:	MOVEI A,5
	JRST PPGI4

ERRILO:	TDZA A,A
INTILM:	 MOVEI A,3
PPGI4:
IT$	MOVE TT,IPCLOK
10$	MOVE TT,.JBTPC"
;STANDARD ENTRY TO BAD ERROR HANDLER; ERROR TYPE IN A, PC IN TT
ERRBD2:	MOVEI R,-1(TT)	;INTERRUPTS LEAVE PC ADVANCED BY ONE
	MOVE B,ERRSW
	HRRZ TT,C2
	HRRZ T,SC2
	CAIGE TT,(P)
	 CAIG T,(P)
	  JSP TT,ERRBD3	;P HAS BEEN CLOBBERED; VERY BAD INDEED!
	HRLM SP,R
	PUSH P,R		;SP,,ADDR WHERE ERROR HAPPENED
	PUSH P,[$ERRFRAME]	;ERROR-FRAME-MARKER
	PUSH P,ERBMSG(A)	;0,,ADDRESS-OF-ERROR-MESSAGE
	SETZM NOQUIT
	JUMPE B,ERRBD4
	SETZM TTYOFF
	MOVEI T,-1(P)
	JSR ERROR4		.SEE EROR4A
ERRBD4:	HRRZ T,C2
	ADDI T,3
	CAIE T,(P)
	 JRST EROR1A
	SETZM TTYOFF
	STRT [SIXBIT \↑M;SYSTEM PDL CLOBBERED#!!\]
	STRT MESMAJ
	JRST LISPGO

ERRBD3:	MOVE P,C2
	MOVEI B,NIL
	JRST (TT)

ERBMSG:	[SIXBIT \ILGL MACHINE OPERATION!\]
	[SIXBIT \UNDEF FUNC CALLED!\]
IT$	[SIXBIT \JRST TO NIL (LOC 0)!\]
10$	[SIXBIT \QUACK!\]		;SHOULDN'T HAPPEN
	[SIXBIT \ILGL MEMORY REFERENCE!\]
	[SIXBIT \ATTEMPT TO WRITE ON PURE PAGE!\]
	[SIXBIT \PARITY ERROR!\]

IFN ITS,[
UUOGL1:	SETZ A,			.SEE UUOGLEEP
	HRRZ TT,UUOGLEEP	;GET ADDRESS OF BAD UUO
	CAIE TT,1
	 JRST ERRBD2		;RANDOM ILLEGAL OP
	HRRZ TT,JPCSAV		;OOPS, IT CAME FROM NIL!
	MOVEI A,2		;SUPER LOSER
	AOJA TT,ERRBD2
]		;END OF IFN ITS

]		;END OF IFE QIO

IFN QIO,[

ERRBAD:	MOVE T,UUTSV
	MOVEM D,ERRSVD
	SETZM JPCSAV		;TOO LATE TO GET JPC
	MOVE D,UUOH
IFN ITS,[
	JRST UUOGL2
UUOGL1:	MOVEM D,ERRSVD
	MOVE D,UUOGLEEP
];END IFN ITS
UUOGL2:
IT$	SUBI D,THIRTY+5		;SEE IF LOSING INSTRUCTION WAS AN ≠X
IT$	TRNN D,-1
IT$	 JRST $XLOST
IT$	ADDI D,THIRTY+5-1	;ELSE MOVE PC BACK TO LOSING INST
	SKIPN VMERR		;SKIP IF USER HANDLER
	 JRST UUOGL7
	PUSH FXP,ERRSVD		;YES, SET UP USER INTERRUPT
	PUSH FXP,D
	HRLI D,(D)
	HRRI D,UIMILO+100000	;ILLEGAL OPERATION
	PUSHJ P,UINT
	POP FXP,ERRSVD
	POP FXP,D
	JRST 2,@ERRSVD		;RESTORE MACHINE FLAGS

UUOGL7:	EXCH D,ERRSVD		;NO USER HANDLER
IT$	.CALL UUOGL8		;CRAP OUT TO DDT
10$	OUTSTR [ASCIZ\?ILLEGAL INSTRUCTION - BAD ERROR\]	
	 .VALUE

IFN ITS,[
UUOGL8:	SETZ
	SIXBIT \LOSE\		;TELL DDT WE'RE LOSING
	  1000,,1+.LZ %PIILO	;ILLEGAL OPERATION
	400000,,ERRSVD		;NEW PC

]		;END OF IFN ITS
]		;END OF IFN QIO

SUBTTL	MISCELLANEOUS ERROR ROUTINES

UUONVE:	PUSHJ P,NCONS
	MOVEI B,QNUMBERP
	PUSHJ P,XCONS
	FAC [NUMBER FUNCTION RETURNED NON-NUMERIC VALUE!]
	JRST UUONVL

SASERR:	EXCH A,B
	WTA [BAD ALIST - ASSOC!]
	EXCH A,B
	JRST SAS4

UUOMER:	HRRZ A,40
	LER3 [SIXBIT \ - MACRO NOT PERMITTED IN UUO CALL!\]
UUOFER:	HRRZ A,40
	LER3 [SIXBIT \ - WRONG NUMBER OF ARGS SUPPLIED BY UUO CALL!\]

IFN BIGNUM,[
REMAIR:	WTA [FLONUM ARG TO REMAINDER!]
	JRST -4(T)
]		;END OF IFN BIGNUM

UNOVER:
IFE NARITH,	TLNN T,100		.SEE %PCFXU	;FLOATING UNDERFLOW
IFN NARITH,	TLNN A,100		.SEE %PCFXU	;FLOATING UNDERFLOW
OVFLER:	LERR [SIXBIT \ARITHMETIC OVERFLOW!\]
UNFLER:	LERR [SIXBIT \ARITHMETIC UNDERFLOW!\]

ER2:	LERR MES3	;CONTEXT ERROR WITH DOT NOTATION -READ
ER3:	LERR [SIXBIT \BLAST? - READ!\]
ER4:	LERR [SIXBIT \GO OUT OF CATCH-BREAK DAMN#!!\]
RDNMER:	LERR [SIXBIT \NUMERIC OVERFLOW - READ!\]

ADEAD:	JFCL		;PUSHJ OR JRST THROUGH DEAD ARRAY PTR
	MOVEI A,ARQLS	;COULD ALSO GET HERE VIA ACALL/AJCALL
	FAC [ARRAY DEFINITION LOST!]


EG1:	UGT [NOT SEEN AS PROG TAG!]
	JRST GO2

INTNCO:	PUSH P,A		;INTERN CRAP-OUT
	MOVEI A,OBARRAY
	EXCH A,VOBARRAY
	UNLOCKI
	PUSHJ P,BADOB
	POP P,A
	JRST INTRN4
BADOB:	FAC [BAD VALUE FOR OBARRAY!]


DFPER:	POPI P,1
	POP P,A
	WTA [WRONG FORMAT - DEFPROP!]
	JRST DEFPROP

DEFNER:	POPI P,1
	POP P,A
	WTA [WRONG FORMAT - DEFUN!]
	JRST DEFUN

NCNCER:	WTA [NON-LIST - NCONC!]
	JRST .NCONC

APPERR:	WTA [NON-LIST - APPEND!]
	JRST .APPEND

PNGE:
PNGE1:	%WTA NASER
	JRST -2(T)

NASER:	SIXBIT \ATOMIC SYMBOL REQUIRED!\
SBADSP:	SIXBIT \ BAD SPACE TYPE - STATUS!\


;;; INCREDIBLE CROCK TO CONSTRUCT AN ERROR MESSAGE
;;; CONTAINING THE NAME OF THE APPROPRIATE CAR/CDR FUNCTION.

CA.DER:	PUSH FXP,[SIXBIT \ILLEGA\]
	PUSH FXP,[SIXBIT \L DATU\]
	PUSH FXP,[SIXBIT \M - CX\]
	PUSH FXP,[SIXBIT \R!!!! \]
CA.DE1:	TRNN T,776
	JRST CA.DE2
	ROT T,-1
	JRST CA.DE1
CA.DE2:	MOVEI D,-1(FXP)
	HRLI D,060600
CA.DE3:	ROT T,1
	MOVEI TT,'A
	TRNE T,1
	MOVEI TT,'D
	IDPB TT,D
	TRNN T,400000
	JRST CA.DE3
	MOVEI TT,'R
	IDPB TT,D
	%WTA -3(FXP)
	SUB FXP,R70+4
	JRST CR1A



NILSETQ:	PUSH P,A	;SOME NERD TRIED TO SETQ NIL, MAYBE?
	PUSH P,CPOPAJ
	CAIE T,VNIL
	JRST TSETQ		;NO, 'TWAS REALLY A TSETQ, MAYBE?
	MOVEI A,QNILSETQ
	%FAC NIHIL

TSETQ:	CAIE T,VT
	JRST XSETQ		;NO, I DON'T KNOW WHAT IT WAS!
	MOVEI A,QTSETQ
	%FAC VERITAS

XSETQ:	HRLM T,QXSET1		;HAND VALUE CELL (?) TO LOSER
	MOVEI A,QXSETQ
	%FAC PURITAS

STORE5:	HRRZ A,-1(P)
	%WTA [SIXBIT \DIDN'T EVAL TO GOOD ARRAY REFERENCE - STORE!\]
	MOVEM A,-1(P)
	JRST STORE7

RPLCA0:	WTA [BAD ARG - RPLACA!]
	JRST RPLACA
RPLCD0:	WTA [BAD ARG - RPLACD!]
	JRST RPLACD
RPLCA1:	WTA [PURE ARG - RPLACA!]
	JRST RPLACA
RPLCD1:	WTA [PURE ARG - RPLACD!]
	JRST RPLACD

%ARR0A:	WTA [WRONG TYPE ARRAY - ARRAYCALL!]
	JRST %ARR0B
%ARR0:	WTA [NOT ARRAY POINTER!]
%ARR0B:	MOVEM A,1(D)
	JRST %ARR7

LDGETQ:	FAC [CAN'T GET DDT SYMBOL - FASLOAD!]
LDXERR:	LERR [SIXBIT \BAD VALUE FOR "PURE" - FASLOAD!\]
10$ LDYERR:	LERR [SIXBIT \BAD VALUE FOR *PURE - FASLOAD!\]
LDALREADY:
Q%	LERR [SIXBIT \ALREADY FASLOADING!\]
Q$	FAC [INCORRECTLY NESTED FASLOAD!]

IFE BIGNUM*DBFLAG*CXFLAG,[
LDATE9:	QBIGNUM
	QDOUBLE
	QCOMPLEX
	QDUPLEX

LDATER:
HN%	SKIPA A,LDATE9-3(T)
HN$	MOVE A,LDATE9-3(T)
]		;END OF IFE BIGNUM*DBFLAG*CXFLAG
HN% FASHNE:	MOVEI A,QHUNK
IFE HNKLOG*BIGNUM*DBFLAG*CXFLAG, LER3 [SIXBIT \IN FASL FILE, BUT NOT IMPLEMENTED IN THIS LISP!\]

.SEE DBCONS
.SEE CXCONS
.SEE DXCONS
IFE DBFLAG*CXFLAG, NUM1MS: SIXBIT \CONS IN COMPILED CODE, BUT NOT IMPLEMENTED IN THIS LISP!\

IBSERR:	MOVEI A,IN10
	EXCH A,VIBASE
	PUSHJ P,NCONS
	MOVEI B,QIBASE
	PUSHJ P,XCONS
	PUSH P,[RD0B1]
	FAC [BAD VALUE FOR IBASE!]

BASER:	MOVEI A,IN10
	EXCH A,VBASE
	PUSHJ P,NCONS
	MOVEI B,QBASE
	PUSHJ P,XCONS
	PUSH P,[PRINI]
	FAC [BAD VALUE FOR BASE!]

IFE QIO,[
LINELR:	SAVE A B
	MOVE A,OLINEL
	EXCH A,VLINEL
	PUSHJ P,NCONS
	MOVEI B,QLINEL
	PUSHJ P,XCONS
	PUSHJ P,LINLR1
	RSTR B A
	JRST (D)

LINLR1:	FAC [BAD VALUE FOR LINEL!]
]			;END OF IFE QIO

IFN USELESS,[
%LVERR:	SETZ A,
	EXCH A,V%LEVEL
	PUSHJ P,NCONS
	MOVEI B,Q%LEVEL
	PUSHJ P,XCONS
	PUSH P,[%LVCHK]
	FAC [BAD VALUE FOR PRINLEVEL!]

%LNERR:	SETZ A,
	EXCH A,V%LENGTH
	PUSHJ P,NCONS
	MOVEI B,Q%LENGTH
	PUSHJ P,XCONS
	PUSH P,[%LNCHK]
	FAC [BAD VALUE FOR PRINLENGTH!]

]			;END OF IFN USELESS


SUBTTL	A PANDORA'S BOX OF ERROR MESSAGES
	
	NIHIL:	SIXBIT \NIHIL EX NIHIL - DON'T SETQ NIL!\
	VERITAS: SIXBIT \VERITAS AETERNA - DON'T SETQ T!\
	PURITAS: SIXBIT \PURITAS NECESSE EST - DON'T DO RANDOM BINDINGS!\
	POVPDL:	SIXBIT \REG PDL OVERFLOW!\
	POVFLP:	SIXBIT \FLONUM PDL OVERFLOW!\
	POVFXP:	SIXBIT \FIXNUM PDL OVERFLOW!\
	POVSPDL: SIXBIT \SPEC PDL OVERFLOW!\
	MESMAJ:	SIXBIT \↑M;MAJOR RESTART UNDERTAKEN↑M!\
	UNRECOV: SIXBIT \↑M;UNRECOVERABLE !\
	FLNMER:
	$ARERR:	SIXBIT \NON-FLONUM VALUE!\
	IARERR:
	FXNMER:	SIXBIT \NON-FIXNUM VALUE!\
DB$	DBNMER:	SIXBIT \NON-DOUBLE VALUE!\
CX$	CXNMER:	SIXBIT \NON-COMPLEX VALUE!\
DX$	DXNMER:	SIXBIT \NON-DUPLEX VALUE!\
	NMV3:	SIXBIT \NON-NUMERIC VALUE!\
IFN BIGNUM+CXFLAG,	NMV5:	SIXBIT \UNACCEPTABLE NUMERIC VALUE!\
	CAMMES:	SIXBIT \FIXNUM CANT COMPARE TO FLONUM.  IN  =, <, OR >!\
	MES2:	SIXBIT \ILLEGAL OBJECT SOMEWHERE OR OTHER - READ!\
	MES3:	SIXBIT \DOT CONTEXT ERROR!\
	MES5:	SIXBIT \UNDEFINED FUNCTION OBJECT!\
	MES6:	SIXBIT \UNBOUND VARIABLE!\
	MES14:	SIXBIT \NOT INSIDE LEXPR/LSUBR!\
	MES18:	SIXBIT \TOO MANY ARGUMENTS SUPPLIED - APPLY!\
	MES19:	SIXBIT \TOO FEW ARGUMENTS SUPPLIED - APPLY!\
	MES20:	SIXBIT \WRONG NUMBER OF ARGS TO LSUBR!\
	MES21:	SIXBIT \WRONG NUMBER OF ARGS TO FSUBR!\
	EMS1:	SIXBIT \EXTRA CHARS IN LIST - READLIST!\
	EMS3:	SIXBIT \NOT ENOUGH CHARS IN LIST - READLIST!\
	EMS5:	SIXBIT \READ-MACRO CONTEXT ERROR!\
	EMS6:	SIXBIT \BLAST, MISSING ")"!\
	EMS10:	SIXBIT \GOT TO TTY INSIDE S-EXP - READ!\
;	EMS11:	SIXBIT \HOW THE HELL CAN THIS BE?!\	.SEE HHCTB
	EMS12:	SIXBIT \TOO MANY INTERRUPTS - GO AWAY!\
	EMS13:	SIXBIT \LOST USER INTERRUPT!\
	EMS15:	SIXBIT \UNDEFINED FUNCTION IN UUO CALL!\
	EMS16:	SIXBIT \MORE THAN 5 ARGS!\
	EMS18:	SIXBIT \FUNCTION UNDEFINED AFTER AUTOLOAD!\
	EMS21:	SIXBIT \IMPROPER USE OF MACRO - EVAL!\
	EMS22:	SIXBIT \ILGL GO OR RETURN - NOT INSIDE A PROG!\
	EMS25:	SIXBIT \UNEVALUABLE DATUM - EVAL!\
	EMS26:	SIXBIT \FILE NOT FOUND!\
Q%	EMS27:	SIXBIT \NO OUTPUT UNIT SELECTED!\
Q%	EMS28:	SIXBIT \NO READ SOURCE SELECTED!\
	EMS29:	SIXBIT \NO CATCH FOR THIS TAG - THROW!\
	EMS31:	SIXBIT \INVALID ARG TO GENSYM!\
	EMS34:	SIXBIT \NOT SUBR POINTER!\
Q%	NONXDV:	SIXBIT \NON-EXISTENT DEVICE CHANNEL!\
Q%	SCRUDE:	SIXBIT \I/O SCREW!\
Q%	DEVFUL:	SIXBIT \ FULL - DELETE SOME FILE↑MAND TYPE $P TO RESUME↑M!\
Q%	OPNLUZ:	SIXBIT \↑M;I/O CHANNEL OPEN FAILURE!\
	STRTCR:	SIXBIT \↑M!\

SUBTTL	YET MORE MISCELLANEOUS ERROR ROUTINES
IFE QIO,[

IFE D10,[

;	PUTCODE [OPNER]\27+2*MOBIOF,INT,ERR

;;; SHARED ROUTINE FOR AN OPEN THAT LOSES.  TRIES TO BE HELPFUL.

OPNER:	LDB A,[270400,,-2(T)]	;GIVE OUT MESSAGE FOR ERROR UPON
	CAIE A,0		;ATTEMPTING TO OPEN I/O CHANNEL
	CAIL A,NOFCH
	.VALUE
	CAIN A,LPTC
	SETZM LPTON
IFN MOBIOF,[
	CAIN A,DISC
	SETZM DISPON
]		;END OF IFN MOBIOF
	CAIN A,UTOC
	SETZM TAPWRT
	SKIPN ERRSW
	JRST OPNR3
	SETZM TTYOFF
	.OPEN ERRC,OERRC	;THE ERRC IS ALWAYS RESERVED FOR THE SYSTEM IN NEWIO
	JRST OPNR3
OPNER1:	.IOT ERRC,A
	CAIN A,14
	JRST OPNER2
	PUSHJ P,TYO
	JRST OPNER1
OPNER2:	IFE QIO, SETZM ERRSW
OPNR3:	LERR OPNLUZ		;I/O CHANNEL OPEN FAILURE

OERRC:	SIXBIT \   ERR\
	1

;	ENDCODE [OPNER]

]		;END OF IFE D10

]		;END OF IFE QIO

IFE QIO,[

UTOER1:	SETZM TAPWRT
	SETZM UTOOPD
	MOVEI A,QUWL
	%FAC EMS27

URIOER:	SETZM TAPRED
	MOVEI A,QURL
	%FAC EMS28

IFE D10,[

IOERR:	.SUSET [.SIPIRQC,,A]
	MOVEM A,INTSV
	HRRZ A,INT+1
	LDB A,[270400,,-1(A)]
	CAIL A,NOFCH
	.VALUE 
	DPB A,[270400,,IOST]
	XCT IOST
	LDB A,[330400,,A]
	CAIN A,11
	JRST IODF
	CAIN A,4
	LERR NONXDV		;NON-EXISTENT DEVICE CHANNEL
	CAIE A,10
	JRST IOE3
	LDB A,[270400,,IOST]
IFN MOBIOF,[
	CAIE A,IMXC
	CAIN A,OMXC
	LERR [SIXBIT \MPX NOT OPENED!\]
]		;END OF IFN MOBIOF
	SKIPE INTSV
	.VALUE		;LOSING TWO INTERRUPTS AT SAME TIME
	PUSH P,INT+1
	PUSH P,A
	PUSH P,CPOPAJ
	.SUSET PINBL
	CAIN A,UTIC
	JRST URIOER
	CAIE A,UTOC
IOE3:	LERR SCRUDE	;I/O SCREW
]		;END OF IFE D10

]		;END OF IFE QIO

IFN MOBIOF,[

;	PUTCODE [MOBY I/O ERRORS]120,MIO,ERR,UIO

DERR1:	SIXBIT \DSLAVE FILE MISSING!\
DERR2:	SIXBIT \DISPLAY SLAVE HAS NOT BEEN OPENED!\
DERR3:	[SIXBIT \WRONG NUMBER OF ARGS TO SOME FUNCTION - DSLAVE!\]

DALMES:	WTA [FLONUM ARG REQUIRED - DISPLAY SLAVE!]
	JRST -1(T)

PPBSL4:	MOVE A,(P)
	WTA [BAD ARG TO SOME DISPLAY FUN!]
	JRST PPBSL1


DERR0:	LERR [SIXBIT \SLAVE HAS DIED!\]
DERR:	LERR [SIXBIT \TOO MANY DISPLAY ITEMS!\]		;TABLE OF ERRORS
	LERR [SIXBIT \DISPLAY MEMORY FULL!\]		;RETURNED FROM SLAVE
	LER3 [SIXBIT \ UNKNOWN DISPLAY ITEM!\]
	LERR [SIXBIT \ENORMOUS VECTOR!\]
	LERR [SIXBIT \BAD RELATIVE VECTOR - DSLAVE!\]
	LERR [SIXBIT \BAD FUNCTION - DSLAVE!\]
	LERR [SIXBIT \340 NOT AVAILABLE!\]
	LER3 [SIXBIT \ HAS TOO MANY DISPLAY INFERIORS!\]

;	ENDCODE [MOBY I/O ERRORS]

]		;END OF IFN MOBIOF


;	PUTCODE [ERRERC]15,ERR,SUS

ERRERC:	POP P,A		;LIKE (ERROR MSG ARGS)
	LER3 1,@(P)

ERRERO:	MOVEI A,(B)
	WTA [INVALID ERROR CHANNEL SPECIFICATION!]
	JRST ERRERB

ERERER:	MOVEI D,Q$ERROR
	SOJA T,S2WNAL

;	ENDCODE [ERRERC]




;	PUTCODE [EVAL.A]7,ERR,EVL,SUS

EVAL.A:	SUB P,[LERFRAME,,LERFRAME]	;CLEAR OUT ALL OF ERRFRAME
	PUSHJ P,SAVX5			;SAVE EVERYTING AND EVAL A
	PUSHJ FXP,SAV5M1		;ORDINARY FAIL-ACT ERROR.
	PUSHJ P,EVAL
EVAL.1:	PUSHJ FXP,RST5M1
	JRST RSTX5

;	ENDCODE [EVAL.A]


IFE D10\QIO,[
;	PUTCODE [IODF]15,ERR,UIO,INT

IODF:	PUSHJ P,SAVX5		;UNFORTUNATELY, INTERRUPTS REMAIN
	PUSHJ P,IOGBND		;SHUT OFF HERE. OTHER INTERRUPTS
	HRRZ A,UWRT		;MAY BE STACKED IN .IPIRQC
	DPB A,[062200,,IODF1]
	STRT IODF1
	STRT DEVFUL		;DEVICE FULL MESSAGE
	.VALUE [ASCII \:VK \]
	PUSHJ P,UNBIND
	PUSHJ P,RSTX5
	SOS INT+1
	JRST INTEX1

;	ENDCODE [IODF]

]		;END OF IFE D10\QIO

;	PUTCODE [.UDT]41,ERR,UIO

.UDT:	MOVEI B,(A)		;COME HERE ON UNDEFINED COMPILED COMPUTED PROG TAG
	PUSHJ P,FIXP
	EXCH A,B
	JUMPN B,.UDT2
	SKIPN ERRSW
	 JRST .UDT1
	PUSHJ FXP,SAV5
	STRT 17,[SIXBIT \↑M;IN !\]
	HRRZ B,-NACS(P)		;GET RETURN ADDRESS
	PUSHJ P,ERRADR		;AND PRINT OUT FUN THEREFOR
	JSP R,RSTR5
.UDT1:	UGT [ UNDEFINED COMPUTED GO TAG!]
	POPJ P,

.UDT2:	SETZM PNBUF
	SETZM PNBUF+1
	SETZM PNBUF+2
	MOVEI C,10.
	MOVEI R,.UDT4
	MOVE AR1,[440700,,PNBUF]
	JUMPGE TT,.+3
	MOVNS TT
	%NEG%
	PUSHJ P,PRINI9
	SETOM LPNF
	MOVEI C,(AR1)
	JRST RINTERN

;	ENDCODE [.UDT]

ESB6:	MOVEI D,0
WNAERR:	CAMG TT,T
	 SKIPA TT,[MES19]	;TOO FEW ARGS
	  MOVEI TT,MES18	;TOO MANY ARGS
	MOVEM B,QF1SB
	PUSH FXP,TT
	JUMPN D,WNAER1		; D ↑= 0 => LISTING ALREADY DONE
	PUSH FXP,R
	PUSHJ FXP,LISTX
	POP FXP,R
WNAER1:	HLRZ B,(P)
	PUSHJ P,XCONS
	MOVEM A,(P)
	PUSHJ P,ARGSCU
	POP FXP,TT
	JRST QF1A


QF3A:	SKIPA TT,[MES19]	;AT THIS POINT, WE CRAP OUT
QF2A:	 MOVEI TT,MES18
	MOVE T,R
	PUSHJ FXP,LISTX
	HLRZ B,(P)
	JUMPN B,.+2
	MOVEI B,QM		;QUESTION MARK!
	PUSHJ P,XCONS
	EXCH A,(P)
	JSP T,%CADR
QF1A:	PUSHJ P,NCONS
	POP P,B
	PUSHJ P,XCONS
	%WNA (TT)
	JRST EVAL


UUOH3C:	SAVE A B
	MOVEI T,EMS18
	JRST UUOUE1

UUOH3A:	SAVE A B
UUOUER:	MOVEI T,EMS15
UUOUE1:	MOVNI A,LUUSV		;UNDEFINED UUO CALL
	PUSH FXP,UUOH+LUUSV(A)
	AOJL A,.-1
	PUSH FXP,40
	HRRZ A,40
	%UDF (T)	;UNDEF FUN IN UUO CALL (OR AFTER AUTOLOAD)
	POP FXP,40
	MOVEI T,LUUSV
	POP FXP,UUOH-1(T)
	SOJG T,.-1
	HRRZ T,A
	JUMPN A,UUOUE2
	HRRZ A,40
	PUSHJ P,EPRINT
Q%	MOVEI A,1
Q%	JRST ERRBD1
Q$	LERR [SIXBIT \UNDEFINED FUNCTION CALLED!\]
UUOUE2:	POP P,B
	POP P,A
	CAIE T,QUNBOUND
	 JRST UUOH0A
	JRST UUOH3A

EPRINT:	SKIPN ERRSW		;ERROR PRINTOUT
	 POPJ P,
	JRST EPRNT1

EV3B:	SKIPA A,EV0B
EV3A:	 HLRZ A,AR1
	%UDF MES5		;UNDEFINED FUNCTION OBJECT
	JRST EV4B

EV3J:	HLRZ A,AR1
	%UDF EMS18		;FN UNDEF AFTER AUTOLOAD
	JRST EV4B

IAP2A:	TDZA TT,TT		;UNDEFINED FN OBJECT
IAP2J:	 MOVEI TT,EMS18-MES5	;FN UNDEF AFTER AUTOLOAD
	HLRZ A,(C)
	SKIPN A
	 HRRZ A,(C)
	%UDF MES5(TT)
	HRRM A,(C)
	JRST ILP1

WNAL0:	MOVE D,(TT)
	TLNE D,1		;SKIP IF LSUBR
	 JRST WNAFOSE
WNALOSE:
	PUSHJ FXP,LISTX		;LISTIFY UP LSUBR ARGS
	MOVEI TT,MES20		;USE LSUBR MESSAGE
WNAL1:	MOVEI B,(D)
	PUSHJ P,XCONS		;CONS FUNCTION NAME ONTO ARG LIST
	PUSH P,A
	MOVEI A,QM		;USE ? FOR ARGS SPEC
	JRST QF1A

STERR:	MOVEI D,(F)
WNAFOSE:	MOVEI TT,MES21	;USE FSUBR MESSAGE
	JRST WNAL1


IFE QIO,[
LDOERR:	UNLOCKI
	PUSHJ P,LDFNSET
	PUSHJ P,UNBIND
	PUSH P,[QFASLOAD]
	JRST UFLR1
]		;END OF IFE QIO

IFN D10,[
FASLUR:	RELEASE TMPC,
FASLUH:	UNLOCKI
	LERR [SIXBIT \CAN'T DEPURIFY HIGH SEGMENT!\]
]		;END OF IFN D10

FASLNX:
10$	SETZM LDXSIZ
10%	SETZM LDXLPC
FASLNC:
IT$ Q%	.CLOSE DSIC,
Q$	HRRZ A,LDBSAR
Q$	PUSHJ P,$CLOSE
10$ Q%	RELEASE DSIC,		;NICE LONG ERR MSG TO REASSURE MACSYMA LOSERS
	LERR [SIXBIT \YOU HAVE RUN OUT OF CORE - FASLOAD!\]	;TOTAL LOSS

LDFERR:
IT$ Q%	.CLOSE DSIC,
Q$	HRRZ A,LDBSAR
Q$	PUSHJ P,$CLOSE
10$ Q%	RELEASE DSIC,
	UNLOCKI
	MOVE A,LDFNAM
	MOVEI B,QFASLOAD
	PUSHJ P,XCONS
	PUSHJ P,UNBIND
	SUB P,R70-LDPRLS+1
	FAC [FILE NOT IN FASLOAD FORMAT!]



IFE QIO,[
UNTAER:	HRRZ A,(P)
	WTA [NEED 2 FILE NAMES IN LIST!]
	HRRM A,(P)
	JRST (T)

UROER:	SETZM UTIOPD
	SETZM TAPRED
	MOVEI B,QUREAD
	JRST UFLER

UAPPER:	SKIPA B,[QUAPPEND]
UKLER:	MOVEI B,QUKILL
UFLER:	UNLOCKI
	PUSH P,B
	PUSHJ P,SCRFUN
UFLR1:	POP P,B
	POP P,IUNIT
	PUSHJ P,XCONS
	%FAC EMS26

UREDER:	PUSH P,A
	MOVEI A,QURL
	SETZM TAPRED
	PUSHJ P,[%FAC EMS28]
	POP P,A
	SKIPN UTIOPD
	POPJ P,
	AOS TAPRED
	JRST URED
]		;END OF IFE QIO

LMBERR:	EXCH A,C
	MOVE R,T
	WTA [BAD LAMBDA LIST!]
	MOVE TT,C
	JRST IPLMB1

LXPRLZ:	LERR [SIXBIT \TOO MANY ARGS TO LEXPR!\]

DOERRE:	MOVEI A,(B)
	WTA [ BAD END TEST FORM - DO!]
	MOVEI B,(A)
	JRST DO4C

GETLE:	EXCH A,B
GETLE1:	WTA [BAD LIST - GETL!]
	EXCH A,B
	JRST GETL



SETWNA:	POP P,A
	MOVEI B,QSETQ
	PUSHJ P,XCONS
	PUSHJ P,NCONS
	WNA [ODD NUMBER OF ARGS - SETQ!]
	JRST EVAL

SIGNPE:	MOVE A,(P)
	WTA [UNRECOGNIZABLE TEST REQUEST - SIGNP!]
	MOVEM A,(P)
	JRST SIGNP0

PROPER:	WTA [BAD ARG - PUTPROP!]
	JRST PUTPROP
RMPER0:	WTA [BAD ARG - REMPROP!]
	JRST REMPROP


LFYER:	PUSHJ P,NCONS		;NOT INSIDE LSUBR
	MOVEI B,QLISTIFY
	PUSHJ P,XCONS		;LET LOSER FIGURE IT OUT
	%FAC MES14

GENSY8:	%WTA EMS31
	PUSH P,A
	JRST GENSY7

ARGCM8:	WTA [ARG TOO LARGE OR <1 - ARG/SETARG!]
	JRST ARGCOM
ARGCM0:	MOVEI R,-1(R)	;NOTE: FLUSHES FLAGS IN LEFT HALF!
	CAIN R,ARGXX
	JRST ARGCM1
	CALLF 2,QLIST
	MOVEI B,QSETARG
	JRST ARGCM2
ARGCM1:	PUSHJ P,NCONS
	MOVEI B,QARG
ARGCM2:	PUSHJ P,ACONS	;LISTIFY AGAIN, WITHOUT LOSING B
	PUSHJ P,XCONS
	%FAC MES14

PTRCKE:	PUSH P,A
	MOVEI A,(TT)
	%WTA EMS34
	MOVEI TT,(A)
	POP P,A
	JRST PTRCHK

.STOLZ:	PUSH P,B
	PUSHJ P,NCONS
	MOVEI B,QM
	PUSHJ P,XCONS
	MOVEI B,QSTORE
	PUSHJ P,XCONS
	POP P,B
	PUSH P,T
	FAC [CAN'T STORE INTO NON-ARRAY!]

IFN QIO,[
TYOAGE:	WTA [NOT ASCII VALUE!]
	JRST TYOARG

GTRDT9:	FAC [BAD VALUE FOR READTABLE!]

EOFE:	MOVEI A,(AR1)
	PUSHJ P,NCONS
	MOVEI B,QRDEOF
	PUSHJ P,XCONS
	PUSHJ P,EOFE1
	JUMPE A,EOF5
	SKIPE T,EOFRTN		;CLOBBER IN EOF VALUE IF NON-NIL
	 HRRM A,-LERSTP-1(T)	; AND IF EOF FRAME EXISTS
	JRST EOF5

EOFE1:	FAC [END OF FILE WITHIN READ!]
]		;END OF IFN QIO

MAPWNA:	MOVEI D,QMAPLIST-MAPLIST-1(TT)
	SOJA T,WNALOSE

DLT6:	CAIE D,MEMBER
	SKIPA D,[QDELQ]
	MOVEI D,QDELETE
	JRST WNALOSE

$CONS9:	MOVEI D,Q$CONS		;ZERO ARGS => ERROR
	SOJA D,WNALOSE

SUSPE:	PUSHJ P,NCONS
	MOVEI B,QSUSPEND
	PUSHJ P,XCONS
	MOVE TT,FXP		;TO ALLOW RETURNS FROM THE FAC, FXP
	SUB TT,R70+1		; MUST BE RESTORED
	SKIPE (FXP)
	 MOVE TT,(FXP)		;IF TOP OF FXP NON-ZERO THEN IS POINTER
	MOVE FXP,TT		; TO OLD FXP; RESTORE CORRECT FXP
	FAC [I/O IN PROGRESS - CAN'T SUSPEND!]

GTPDL1:	WTA [ NOT PDL POINTER!]
	JRST GTPDLP

RAND9:	MOVEI D,QRANDOM
S2WNAL:	SOJA T,S1WNAL

TYPKER:	MOVEI D,QTYIPEEK
S1WNAL:	SOJA T,WNALOSE

GRCTIE:	EXCH A,B
	WTA [NOT VALID READTABLE INDEX!]
	EXCH A,B
	JRST GRCTI

FRERR:	WTA [NOT A FRAME POINTER - FRETURN!]
	JRST FRETURN

IFN USELESS*ITS,[
CRSRP2:	WTA [BAD CURSOR CODE - CURSORPOS!]
	JRST CRSRP3
]		;END OF IFN USELESS*ITS

IFN FUNAFL,[
ALST0:	MOVE A,-1(P)
	WTA [BAD ALIST - EVAL/APPLY!]
	MOVEM A,-1(P)
	JRST ALIST
]		;END OF IFN FUNAFL

LFY0:	WTA [ARG TOO LARGE - LISTIFY!]
	JRST LISTIFY

IFN ITS+SAIL,[
ALCK0:	EXCH A,B
	WTA [BAD ARG - ALARMCLOCK!]
	JRST ALARMCLOCK
]		;END OF IFN ITS+SAIL

PRGER1:	EXCH A,AR2A
	WTA [BAD VAR LIST - PROG!]
	EXCH A,AR2A
	JRST PRG1

DOERR:	POP P,A
	WTA [BAD VAR LIST - DO!]
	MOVEM A,-2(P)
	JRST DO5

DO5ER:	MOVEI A,(B)
	WTA [EXTRANEOUS STEPPER - DO!]
	JRST DO5Q


ATAN.7:	LERR [SIXBIT \OVERFLOW/UNDERFLOW IN ATAN!\]
EXP.ER:	MOVE D,[EXPER1,,[SIXBIT \ARG TOO BIG - EXP!\]]
	JRST NUMER
EXPER1:	EXCH A,B
	JRST EXP.
SIN.ER:	SKIPA D,[SIN.,,[SIXBIT \ARG TOO BIG FOR ACCURACY - SIN!\]]
COS.ER:	MOVE D,[COS.,,[SIXBIT \ARG TOO BIG FOR ACCURACY - COS!\]]
	JRST NUMER
SQR$ER:	SKIPA D,[SQRT.,,[SIXBIT \NEG ARG - SQRT!\]]
LOG.ER:	MOVE D,[LOG.,,[SIXBIT \NON-POS ARG - LOG!\]]
NUMER:	JSP T,PDLNMK		;IF ARG WAS A PDL NUM, GET A REAL ONE
	%WTA (D)		;COMPLAIN TO LOSER
	HLRZS D
	JRST 2,@D

	IARERR
	$ARERR
ARTHER:	%WTA @.-1(T)
	JRST ARITH

1EQNF:	TDZA T,T
1GPNF:	MOVEI T,$GREAT-$EQUAL
	EXCH A,B
	%WTA CAMMES
	JRST $EQUAL(T)
2EQNF:	TDZA T,T
2GPNF:	MOVEI T,$GREAT-$EQUAL
	%WTA CAMMES
	EXCH A,B
	JRST $EQUAL(T)


IFE QIO,[
ER1:	MOVEI A,QM
	SKIPN TAPRED
	JRST ER1A
	HRRZ T,UTIBP
	SUBI T,4
	CAIGE T,UTIB
	MOVEI T,UTIB
	MOVEI TT,LPNBUF-1(T)
	CAILE TT,UTIB+UTBSIZ-1
	MOVEI TT,UTIB+UTBSIZ-1
	SUBI TT,(T)
	HRLI T,PNBUF
	BLT T,PNBUF(TT)
	SETOM LPNF
	PUSHJ P,RINTERN
ER1A:	LER3 MES2
]		;END OF IFE QIO


GCMLOSE:	HRRZ C,GCMES+NFF(F)
	JSR GCRSR
	SETOM PANICP
	%GCL GCLSMS
	SETZM PANICP
	POP P,A
	SETOM IRMVF	;ON GENERAL PRINCIPLES, GCTWA ONCE
	JRST AGC

GCMES:	QLIST
	QFIXNUM
	QFLONUM
DB$	QDOUBLE
CX$	QCOMPLEX
DX$	QDUPLEX
BG$	QBIGNUM
	QSYMBOL
REPEAT HNKLOG, CONC QHUNK,\.RPCNT+1
	QARRAY
	QSYMBOL		;FOR SYMBOL-BLOCKS, SIMPLY SAY "SYMBOL"
IFN .-GCMES-NTYPES-1+1, WARN [WRONG LENGTH TABLE]

GCLSMS:	SIXBIT \STORAGE CAPACITY EXCEEDED!\


;;; COME HERE WHEN THINGS LOOK REALLY DESPERATE IN GC.

GCLUZ:	SKIPN PANICP		;HOPE FOR THE BEST, JPG!
	 SKIPE INHIBIT		;GC-LOSSAGE CAN'T WIN IF INHIBITED
	  CAIA
	   JRST GCMLOSE
	SKIPE C,F
	 HRRZ C,GCMES+NFF(F)	;WELL, IT LOOKS LIKE WE
	JSR GCRSR		; HAVEN'T EVEN A SNOBOL'S
	SETZM TTYOFF		; CHANCE IN HELL HERE...
	JUMPE A,GCLUZ6
	PUSHJ P,PRINT		;TELL LOSER HE LOST TOTALLY
GCLUZ3:	STRT 17,GCLSMS
	STRT 17,[SIXBIT \ BEYOND RECUPERATION!\]
	SKIPLE IRMVF
	 JRST GCLUZ7
GCLUZ5:	MOVEI TT,SPDLORG
	CAILE TT,(SP)		;IF WE LOST OUT GC'ING AT TOP
	 JRST DIE		; LEVEL, WE ARE TOTALLY LOST
GCLUZ4:	STRT 17,MESMAJ		;OTHERWISE WE HAVE HALF A CHANCE
	PUSHJ P,ERRPNU		; OF FREEING UP SOME STORAGE (NO UNWIND-PRO'S)
	JRST LISPGO		; BY UNBINDING SPECIAL VARIABLES

GCLUZ6:	STRT 17,[SIXBIT \SYMBOL BLOCK!\]
	JRST GCLUZ3

GCLUZ7:	SETOM IRMVF
	JRST GCLUZ4


GCPDLOV:	SETZM TTYOFF
	MOVE P,C2
	MOVE FXP,FXC2
	STRT 17,[SIXBIT \↑M;PDL OVERFLOW WHILE IN GC#!!\]
	JRST GCLUZ5


;;; COME HERE WHEN EVERY HOPE FOR RECOVERY HAS BEEN EXHAUSTED.

DIE:	STRT 17,[SIXBIT \↑M;YOU HAVE LOST BADLY#!↑M!\]
	.VALUE
	JRST DIE

SUBTTL	ERROR ADDRESS DECODER

IFN QIO,[
ERRADR:	HRRZ AR1,VMSGFILES
	TLO AR1,200000
ERRAD1:	PUSH P,AR1
	PUSHJ P,ERRDCD
	POP P,AR1
	JRST $PRIN1
]		;END OF IFN QIO


Q% ERRADR:	 PUSH P,CPRIN1
ERRDCD:	MOVEI A,QM		;DECODE ADDRESS AS SUBR OR ARRAY
10$	CAIL B,ENDFUN		; PROPERTY OF SOME ATOM
10%	CAIGE B,BEGFUN		;ADDRESS 0 ALWAYS GIVES OUT QM - SEE BK1A1B
CPRIN1:	 POPJ P,PRIN1		;ERRDCD SAVES T (SEE WNAYOSE)
10$	CAIL B,BEGFUN
10%	CAIGE B,ENDFUN
	 JRST ERRO2E
	CAIL B,BBPSSG
	 CAMLE B,BPSH
	  POPJ P,
ERRO2E:	
10$ 	MOVEI AR2A,BBPSSG
10%	MOVEI AR2A,BEGFUN
	LOCKI			;GCGEN IS NOT INTERRUPT SAFE
	JSP R,GCGEN
		ERRO2Q
	UNLKPOPJ

ERRO2Q:	SKIPE INTFLG	;LET INTERRUPTS HAPPEN - THIS IS A VERY
	JRST ERRO2R	; LONG PROCESS FOR LARGE OBARRAYS!
ERRO2A:	HLRZ TT,(D)
ERRO2C:	HRRZ TT,(TT)
	JUMPE TT,ERRO2B
	HLRZ AR1,(TT)
	HRRZ TT,(TT)
	CAIN AR1,QLSUBR
	 JRST ERRO2H
	CAIE AR1,QSUBR
	 CAIN AR1,QFSUBR
	  JRST ERRO2H
	CAIE AR1,QARRAY
	 JRST ERRO2C
	HLRZ AR1,(TT)
	HRRZ TT,(AR1)
	CAML B,@VBPEND		;IF ARG IS < BPEND, THEN CANT BE AN ARRAY
	 CAIGE TT,-3(B)
	  JRST ERRO2B
	JRST ERRO2G

ERRO2H:	HLRZ TT,(TT)
10$	CAIL B,HILOC	;IF ARG IS IN HIGH SEGMENT,
10$	 JRST ERRO2G	; MUST BE SUBR
	CAML B,@VBPORG
	 JRST ERRO2B	;IF ARG > BPORG, THEN CANT BE A SUBR [MUST BE ARRAY]
ERRO2G:	CAMLE TT,AR2A
	 CAMLE TT,B
	  JRST ERRO2B
	MOVE AR2A,TT
	HLRZ A,(D)
ERRO2B:	HRRZ D,(D)
	JUMPN D,ERRO2A
	JRST GCP8A

ERRO2R:	HRRZ AR1,VOBARRAY
	MOVEI TT,(F)
	SUB TT,TTSAR(AR1)
	UNLOCKI			;GIVE A POOR INTERRUPT
	LOCKI			; A CHANCE IN LIFE
	ADD TT,TTSAR(AR1)
	HRRI F,(TT)
	JRST ERRO2A

SUBTTL	ERROR, ERRFRAME, ERRPRINT

BEGFUN==.

$ERROR:	JUMPE T,EROR1A		;(ERROR) SIMPLY ACTS LIKE (ERR)
	AOJE T,[LERR 1,@(P)]	;(ERROR MSG)
	AOJE T,ERRERC
	AOJN T,ERERER
	POP P,A
ERRERB:	MOVEI B,(A)
	CAIL A,QUDF
	 CAIL A,QUDF+NERINT
	  JRST ERRERN
10$	MOVEI D,(A)
10$	SUBI D,QUDF
.ELSE 	HRREI D,-QUDF(A)
	JRST ERRERD

ERRERN:	PUSHJ P,FIXP
	JUMPE A,ERRERO
	MOVEI D,-5(TT)
	JUMPL D,ERRERO
ERRERD:	CAIL D,NERINT		;# USER INTERRUPT ERRORS - RANGE FROM 0 TO NERINT-1
	 JRST ERRERO
	MOVEI A,POP1J		;(ERROR MSG ARGS CHNO)
	EXCH A,(P)
	IORI D,<(SERINT)>←-5
	DPB D,[2715←30 -1(P)]
	XCT -1(P)		;THIS WINS FOR FAIL-ACT, FOR IT WILL
	POPJ P,			; POPJ BY ISELF WITHOUT COMING HERE;
				; DITTO FOR IO-LOSSAGE.


SUBR:	HRRZ B,(A)		;SUBR 1
	JRST ERRDCD

;;; ERRFRAME TAKES PDL POINTER, AND RETURNS AN ERROR FRAME.
;;; FORM OF RETURNED VALUE:
;;;	(ERR <REGPDL PTR> <ERROR MSG> <SPECPDL PTR>)
;;; WHERE <ERROR MSG> TAKES ONE OF THREE FORMS:
;;;	(<MESSAGE>)
;;;	(<MESSAGE> <LOSING S-EXP>)
;;;	(<MESSAGE> <LOSING S-EXP> <TYPE>)
;;; I.E. IT IS A LIST OF ARGS SUITABLE FOR THE ERROR FUNCTION.

ERRFRAME:	JSP R,GTPDLP	;SUBR 1
		      $ERRFRAME		;MUST APPEAR TWICE
		      $ERRFRAME
	 JRST FALSE
	POPI D,1
	PUSH FXP,D
	PUSHJ FXP,SAV5M1
	MOVE D,2(D)	;D SHOULD POINT TO JUST BELOW THE FRAME MARKER
	PUSH P,R70
	LSHC D,-33
	LSH R,-40
	CAIGE D,ERINT←-33
	 JRST EPR6
	MOVEI A,QUDF(R)
	PUSHJ P,ACONS
	MOVEM A,(P)
EPR6:	HRRZ A,(FXP)
	HRRZ A,3(A)
	HRRZ B,(P)
	PUSHJ P,CONS
	MOVEM A,(P)
	HRRZ A,(FXP)
	HRRZ A,2(A)
	CAIN D,ERINT←-33
	 JRST EPR7
	CAIE D,SERINT←-33
	 SKIPE R
	  JRST EPR5
EPR7:	HRLI A,440600		;IF MSG IS SIXBIT, MUST CREATE
	MOVEM A,CORBP		; AN ATOMIC SYMBOL WHOSE PRINT NAME
	MOVEI T,EPR1		; IS THE MESSAGE
	PUSHJ FXP,MKNR6C
	PUSHJ P,RINTERN
EPR5:	POP P,B
	PUSHJ P,CONS
	PUSH P,CR5M1PJ
	PUSH P,A
	POP FXP,D
	JRST FRM4

EPR1:	ILDB BYTEAC,CORBP
	CAIN BYTEAC,'!	;! IS END OF MESSAGE
Q%	 JRST FALSE
Q$	 POPJ P,
	CAIN BYTEAC,'↑	;↑ CONTROLIFIES NEXT CHARACTER
	 JRST EPR3
	CAIN BYTEAC,'#	;# QUOTES NEXT CHAR
	 ILDB BYTEAC,CORBP
EPR4:	ADDI BYTEAC,40
Q%	POPJ P,
Q$	JRST POPJ1

EPR3:	ILDB BYTEAC,CORBP	;THIS "CONTROLIFICATION" ALGORITHM
	ADDI BYTEAC,40	; CONVERTS ↑M TO CTRL/M, BUT ALSO ↑4 TO
	TRC BYTEAC,100	; LOWER CASE T, ETC.; HENCE CAN REPRESENT
	POPJ P,		; ALL OF ASCII USING ↑ AS AN ESCAPE

IFE QIO,[
ERRPRINT:			;SUBR 1
	JSP R,GTPDLP	;PRINT OUT ERROR MESSAGE STACKED ON  
	   $ERRFRAME	;PDL JUST PRIOR TO POINT SPECIFIED BY ARG
	   $ERRFRAME	;EXTRA COPY OF $ERRFRAME
	 JRST FALSE
	HLRZ TT,1(D)
	JUMPE TT,ERRPT4
	PUSH P,1(D)
	MOVE A,2(D)
	PUSH P,A
	JSR ERROR3
ERRPT3:	MOVEI A,TRUTH
	JRST POP2J

ERRPT4:	MOVE T,D
	JSR ERROR4
	JRST TRUE
]		;END OF IFE QIO

IFN QIO,[
ERRPRINT:			;LSUBR (1 . 2)
	JSP F,PRNARG
	   [QERRPRINT]
	PUSHJ P,OFCAN
	JSP R,GTPDLP	;PRINT OUT ERROR MESSAGE STACKED ON  
	   $ERRFRAME	; PDL JUST PRIOR TO POINT SPECIFIED BY ARG
	   $ERRFRAME	;EXTRA COPY OF $ERRFRAME
	 JRST FALSE
	PUSHJ P,ERROR3
	JRST TRUE


;OUTPUT FILE CANONICALIZER.  MAKES CONTENTS OF AR1
; INTO AN ORDINARY LIST SUITABLE FOR FEEDING TO STRT.

OFCAN:	PUSH P,A		;SAVES T
	MOVEI A,(AR1)
	SKIPGE AR1
	 PUSHJ P,ACONS
	HRRZ B,V%TYO
	TLNN AR1,200000
	 PUSHJ P,XCONS
	MOVEI AR1,(A)
	JRST POPAJ

]		;END OF IFN QIO
β